home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / ELECTRON / PCB_DESI / H027.ZIP / TOOLS.EXE / lha / SHOW_LAY.PAS < prev    next >
Pascal/Delphi Source File  |  1990-11-21  |  2KB  |  110 lines
  1. program show_lay;
  2.  
  3. uses crt;
  4.  
  5. const max_arr = 30000;
  6.  
  7. type barr = array[0..max_arr] of byte;
  8.      iarr = array[0..max_arr] of integer;
  9.  
  10. var
  11.   b,s : ^barr;
  12.   x,y : ^iarr;
  13.  
  14. procedure init;
  15. var
  16.   i:word;
  17. begin
  18.   new(b);
  19.   new(s);
  20.   new(x);
  21.   new(y);
  22.   for i := 0 to max_arr do
  23.   begin
  24.     b^[i] := 0;
  25.     s^[i] := 0;
  26.     x^[i] := 0;
  27.     y^[i] := 0;
  28.   end;
  29. end;
  30.  
  31. procedure show_lay_inp;
  32. type
  33.   lay_rec = record b,s : byte; x,y : integer; end;
  34. var
  35.   f1 : file of lay_rec;
  36.   f2 : text;
  37.   lr : lay_rec;
  38.   i  : word;
  39.   size : word;
  40.   w1 : string;
  41. begin
  42.   assign(f1,paramstr(1));
  43.   reset(f1);
  44.   assign(f2,'show_lay.dat');
  45.   rewrite(f2);
  46.   size := filesize(f1);
  47.   writeln(f2,' In ',paramstr(1),' ',size,' datalines found..');
  48.   if length(paramstr(2)) > 0 then
  49.   begin
  50.     w1 := paramstr(2);
  51.     val(w1,size,i);
  52.     if i > 0 then
  53.     begin
  54.       writeln('Error in paramstr(2)');
  55.       halt;
  56.     end;
  57.     writeln(f2,' In ',paramstr(1),' ',size,' datalines to read..'#13#10);
  58.   end;
  59.   {$i-}
  60.   for i := 1 to size do
  61.   begin
  62.     read(f1,lr);
  63.     b^[i] := lr.b;
  64.     s^[i] := lr.s;
  65.     x^[i] := lr.x;
  66.     y^[i] := lr.y;
  67.   end;
  68.   close(f1);
  69.   {$i+}
  70.   writeln(ioresult);
  71.   writeln(f2,' Data of ',paramstr(1),#13#10);
  72.   writeln(f2,' Line   Block  Sympen  Xposition  Yposition');
  73.   for i := 1 to size do
  74.   begin
  75.     writeln(f2,i:5,b^[i]:8,s^[i]:8,x^[i]:11,y^[i]:11);
  76.   end;
  77.   close(f2);
  78. end;
  79.  
  80. procedure save_data;
  81. type
  82.   lay_rec = record b,s : byte; x,y : integer; end;
  83. var
  84.   f1 : file of lay_rec;
  85.   lr : lay_rec;
  86.   i  : word;
  87.   size : word;
  88.   w1 : string;
  89. begin
  90.   if paramstr(3) = '' then exit;
  91.   assign(f1,paramstr(3));
  92.   rewrite(f1);
  93.   for i := 1 to size do
  94.   begin
  95.     lr.b := b^[i];
  96.     lr.s := s^[i];
  97.     lr.x := x^[i];
  98.     lr.y := y^[i];
  99.     write(f1,lr);
  100.   end;
  101.   close(f1);
  102. end;
  103.  
  104. begin
  105.   clrscr;
  106.   init;
  107.   show_lay_inp;
  108.   save_data;
  109. end.
  110.